home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Commodore Disk UserVolume 4 #7
/
Commodore_Disk_User_Vol.4_7_1991_-.d64
/
m_c 64-tel
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
12KB
|
717 lines
1000 ! this is the code for 64-tel
1010 ! that mimics teletext through
1020 ! the use of the disk drive
1030 !
1040 *=$9000,$6000
1050 !
1060 ! initialise
1070 lda #15 ! open ext. sound
1080 sta $d418 ! and set up 'beep'
1090 lda #100
1100 sta $d400
1110 sta $d401
1120 lda #0
1130 sta $d405
1140 lda #240
1150 sta $d406
1160 lda #$20
1170 sta $d404
1180 lda #$80 ! auto repeat
1190 sta 650
1200 jsr $e544 ! clear screen
1210 lda #0
1220 sta $d020
1230 sta $d021
1240 lda #<title ! display title
1250 ldy #>title
1260 jsr $ab1e
1270 ldx #5 ! date & time input
1280 stx di
1290 dat lda di
1300 asl a
1310 tax
1320 lda adt,x ! address table
1330 ldy adt+1,x
1340 jsr $ab1e ! print message
1350 jsr ino ! get number input
1360 php
1370 pha
1380 lda #<cl
1390 ldy #>cl
1400 jsr $ab1e
1410 pla
1420 plp
1430 bcc dt2
1440 jmp dat
1450 bdc clc ! binary to dec conv.
1460 sed
1470 lda #0
1480 bd1 adc #1
1490 dey
1500 bne bd1
1510 cld
1520 rts
1530 dt2 ldx di
1540 sta dtt,x ! date & time table
1550 ldy #152
1560 dd1 dex ! delay
1570 bne dd1
1580 dey
1590 bne dd1
1600 dec di
1610 bpl dat
1620 ldx #5 ! set up clock
1630 dt3 lda #0
1640 ldy dtt,x
1650 beq dt5
1660 jsr bdc ! bin > dec conv.
1670 dt5 sta $dc06,x
1680 dex
1690 cpx #2
1700 bne dt3
1710 lda #0
1720 sta $dc08
1730 lda $dc08
1740 sei
1750 lda #$7f ! kill timer irq
1760 sta $dc0d
1770 sta $dd0d
1780 lda #<irq ! set up raster int.
1790 sta $314
1800 lda #>irq
1810 sta $315
1820 lda #$81
1830 sta $d01a
1840 lda #57
1850 sta $d012
1860 lda $d011
1870 and #$7f
1880 sta $d011
1890 cli
1900 jmp main ! to main prog.
1910 ino jsr gen ! get a digit no.
1920 sta ten ! tens
1930 jsr gen
1940 sta un ! units
1950 jsr evn ! evalute no.
1960 ldx di
1970 sec
1980 cmp lmu,x ! upper no. limit
1990 bcs in1
2000 cmp lml,x
2010 bcs in2
2020 sec
2030 in1 rts
2040 in2 clc
2050 jmp in1
2060 gend jsr $ffe4 ! slightly differ
2070 cmp #$30
2080 bmi gend
2090 cmp #$3a
2100 bpl gend
2110 pha
2120 jmp cgen ! continue
2130 gen jsr $ffe4 ! get a keypress
2140 cmp #$30
2150 bmi gen
2160 cmp #$3a ! was it 0 - 9 ?
2170 bpl gen
2180 pha
2190 jsr $e716
2200 cgen lda #$21 ! sound 'beep'
2210 sta $d404
2220 ldy #20
2230 gn1 dex
2240 bne gn1
2250 dey
2260 bne gn1
2270 lda #$20
2280 sta $d404
2290 pla
2300 sbc #$2f ! asc to real value
2310 rts
2320 evn lda un
2330 ldx ten
2340 beq ev2
2350 clc
2360 ev adc #10
2370 dex
2380 bne ev
2390 ev2 rts
2400 title byt 13,142
2410 byt "[156]welcome to ...",13
2420 byt " [166][166][166] [166] [166] [158] tel ",13
2430 byt " [166] [166] [166] ",13
2440 byt " [166][166][166][166] [166] [166] [213][201] tel ",13
2450 byt " [166] [166] [166][166][166][166][166][166] [202][203] ",13
2460 byt " [166] [166] [166] [158] tel ",13
2470 byt " [166][166][166] [166] ",13,0
2480 cl byt "[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]",0
2490 tl byt "[147]",14,"[158]p100 64-tel 23 jan '90 [158]00:00:00 [156] [146]",0
2500 mon byt "janfebmaraprmayjunjulaugsepoctnovdec"
2510 m0 byt " enter date (01-31) : [157][157]",0
2520 m1 byt " enter month (01-12) : [157][157]",0
2530 m2 byt " enter year (90-99) : [157][157]",0
2540 m3 byt " time seconds (00-59): [157][157]",0
2550 m4 byt " time minutes (00-59): [157][157]",0
2560 m5 byt " time hours (01-12) : [157][157]",0
2570 di byt 0
2580 cp byt 0
2590 ten byt 0
2600 un byt 0
2610 lmu byt 32,13,100,60,60,13
2620 lml byt 1,1,90,0,0,1
2630 adt wor m0,m1,m2,m3,m4,m5
2640 dtt byt 0,0,0,0,0,0
2650 bam byt 66
2660 index byt 100
2670 !
2680 irq lda $d019
2690 sta $d019
2700 jmp ir2
2710 ire pla
2720 tay
2730 pla
2740 tax
2750 pla
2760 rti
2770 ir2 lda irt ! irq toggle
2780 eor #1
2790 sta irt
2800 tax
2810 lda $d018 ! which screen
2820 and #15
2830 ora wcs,x
2840 sta $d018
2850 lda irl,x ! next ras. line
2860 sta $d012
2870 ldy #31
2880 srp dey ! slight raster pause
2890 bne srp
2900 lda irc,x ! screen col?
2910 sta $d021
2920 dex
2930 bne ir3
2940 jmp $ea31
2950 ir3 lda $7e9 ! flash mode ?
2960 bne ir5 ! yes
2970 ldx ro
2980 bne irr
2990 lda #$10
3000 jmp irr2
3010 irr lda #$20
3020 irr2 sta wcs+1
3030 jmp ir4
3040 ir5 dec fr ! flash rate
3050 beq ir6
3060 jmp ir4
3070 ir6 lda #50
3080 sta fr
3090 lda wcs+1
3100 eor #$30
3110 sta wcs+1 ! toggle
3120 jmp ir4
3130 pb byt $10,$20
3140 fr byt 0
3150 st byt 0
3160 ro byt 0
3170 ir4 dec ud ! update delay
3180 bne ire
3190 lda #10
3200 sta ud
3210 lda $dc0b
3220 and #$7f
3230 jsr dsp ! decimal split
3240 sta $41b
3250 sty $41c ! display clock
3260 lda $dc0a
3270 jsr dsp
3280 sta $41e
3290 sty $41f
3300 lda $dc09
3310 jsr dsp
3320 sta $421
3330 sty $422
3340 lda $dc08
3350 ! flash & rest
3360 jmp ire
3370 dsp pha ! decimal split
3380 and #15
3390 clc
3400 adc #$30
3410 tay
3420 pla
3430 lsr a
3440 lsr a
3450 lsr a
3460 lsr a
3470 clc
3480 adc #$30
3490 rts
3500 irt byt 0
3510 irc byt 0,0
3520 irl byt 55,239
3530 wcs byt 16,16
3540 ud byt 0
3550 main lda #<tl ! top line
3560 ldy #>tl
3570 jsr $ab1e
3580 ldy dtt ! get date
3590 jsr bdc
3600 jsr dsp
3610 sta $40f
3620 sty $410
3630 ldy dtt+2 ! get year
3640 jsr bdc
3650 jsr dsp
3660 sta $417
3670 sty $418
3680 lda #0
3690 ldx dtt+1 ! get month
3700 dex
3710 beq mn3
3720 clc
3730 mn2 adc #3
3740 dex
3750 bne mn2
3760 tax
3770 mn3 clc
3780 lda mon,x
3790 and #$bf
3800 sta $412
3810 lda mon+1,x
3820 and #$bf
3830 sta $413
3840 lda mon+2,x
3850 and #$bf
3860 sta $414
3870 !
3880 ! the following is crucial
3890 !
3900 lda #$81
3910 sta $dc0e
3920 ldx #255
3930 tax
3940 cbm sta $1800,x ! clear bam
3950 dex
3960 bne cbm
3970 lda #0
3980 jsr $ff90 ! turn off messages
3990 ldx #<bam
4000 ldy #>bam ! load page table
4010 lda #1
4020 jsr d(NULL)
4030 ldx #<index ! load main page
4040 ldy #>index ! p100 @ $800
4050 lda #1
4060 jsr d(NULL)
4070 lda #8 ! p100 --> $1000
4080 ldx #8
4090 ldy #$10
4100 jsr move
4110 jsr sach
4120 gk jsr $ffe4
4130 cmp #0
4140 bne gl
4150 sta ro
4160 jmp gk
4170 gl cmp #$20 ! reveal key?
4180 bne gk2
4190 lda #1
4200 sta ro ! reveal on
4210 lm lda $dc01 ! lock mode
4220 and #$10
4230 beq lm
4240 jmp gk
4250 gk2 cmp #136 ! cancel?
4260 bne chl
4270 jmp ent ! end 64-tel
4280 chl cmp #80 ! p' pages available
4290 bne chk
4300 jsr dp ! display pages
4310 jmp gk
4320 chk cmp #133 ! f1 ?
4330 bne ch2
4340 jsr stl ! save top line
4350 jsr edit ! to editor
4360 jsr rtl ! restore
4370 jmp gk
4380 ch2 cmp #$31 ! '1' ?
4390 bne gk
4400 ldx $7eb
4410 stx cp ! current page
4420 jsr f7
4430 ldx $7eb
4440 cpx cp
4450 beq gk ! select same page
4460 cpx #100
4470 beq ind
4480 lda $1800,x ! page exist ?
4490 bne ch3
4500 ind lda #8
4510 ldx #$10
4520 ldy #$08
4530 jsr move
4540 jsr sach ! scn & col handler
4550 jmp gk
4560 ch3 lda #0
4570 sta $7ec
4580 ldx #$eb
4590 ldy #7
4600 lda #1
4610 jsr d(NULL)
4620 jsr sach
4630 jmp gk
4640 dp jsr stl
4650 jsr $e544 ! display pages
4660 lda $7e9 ! store f/r mode
4670 sta dtp+1
4680 lda #0 ! set reveal mode
4690 sta $7e9
4700 lda #19 ! home
4710 jsr $e716
4720 lda #17
4730 jsr $e716
4740 ldx #100
4750 dpl stx dtp
4760 lda $1800,x
4770 beq dpl2
4780 lda #0
4790 jsr $bdcd
4800 lda #32
4810 jsr $e716
4820 dpl2 ldx dtp
4830 inx
4840 cpx #200 ! reached page 200?
4850 bne dpl
4860 dpl3 jsr $ffe4
4870 cmp #0 ! wait for key
4880 beq dpl3
4890 lda dtp+1
4900 sta $7e9
4910 jmp sach+3
4920 stl ldx #$27
4930 st2 lda $400,x
4940 sta stt,x
4950 lda $d800,x ! save table
4960 sta ctt,x
4970 dex
4980 bpl st2
4990 rts
5000 dtp byt 0,0
5010 stt byt " "
5020 ctt byt " "
5030 rtl ldx #$27
5040 rt2 lda stt,x
5050 sta $400,x
5060 lda #$60
5070 sta $7c0,x
5080 lda ctt,x
5090 sta $d800,x
5100 dex
5110 bpl rt2
5120 rts
5130 sach jsr stl
5140 lda #4
5150 ldx #8
5160 ldy #4
5170 jsr move ! copy --> screen
5180 lda #4
5190 ldx #12
5200 ldy #$d8
5210 jsr move ! colour --> rom
5220 lda #4
5230 sta sss+2
5240 lda #12
5250 sta scc+2
5260 ldy #$28
5270 scc lda $8000,y
5280 and #$80
5290 beq sch2
5300 lda #$60
5310 sss sta $0400,y
5320 sch2 iny
5330 beq ipp
5340 cpy #$e8
5350 beq sch3
5360 jmp scc
5370 ipp inc scc+2 ! inc. pointers
5380 inc sss+2
5390 jmp scc
5400 sch3 lda sss+2
5410 cmp #7
5420 bne scc
5430 lda $be8
5440 sta irc+1
5450 lda $7ea
5460 jsr tlc ! set case
5470 jmp rtl
5480 !
5490 ! this section is the page
5500 ! editor program. later on it
5510 ! will be added to the main code
5520 !
5530 !
5540 edit lda #19 !home
5550 jsr $e716
5560 lda #17
5570 jsr $e716
5580 lda #0
5590 sta $7e9 ! auto reveal mode
5600 sta $7e8 ! black screen
5610 sta $7ea ! lowercase
5620 jsr tlc ! to lowercase
5630 ed1 lda 214
5640 bne ed2 ! cursor on top line?
5650 lda #17
5660 jmp ed3
5670 ed2 sec
5680 cmp #24
5690 bcc ed4
5700 lda #145
5710 ed3 jsr $e716
5720 ed4 ldy $d3
5730 lda ($d1),y
5740 eor #$80
5750 sta ($d1),y
5760 ed4t jsr $ffe4 ! get chars
5770 cmp #0
5780 bne ed4s
5790 ldx #1
5800 lme lda $dc01 ! lock mode
5810 cmp #223
5820 bne lmo
5830 stx ro
5840 jmp lme
5850 lmo dex
5860 stx ro
5870 jmp ed4t
5880 ed4s pha
5890 ldy $d3
5900 lda ($d1),y
5910 eor #$80
5920 sta ($d1),y
5930 pla
5940 cmp #133 ! f1 ?
5950 bpl ed6
5960 ed5 jsr $e716
5970 jmp ed1
5980 ed6 cmp #141 ! f8 ?
5990 bpl ed5
6000 sec
6010 sbc #133
6020 asl a
6030 tax
6040 jsr fm ! function message
6050 lda dvt,x ! dispatch vector
6060 ldy dvt+1,x ! table
6070 sta ed7+1
6080 sty ed7+2
6090 ed7 jsr $8000
6100 nop
6110 jmp ed1
6120 fm lda mvt,x ! message vector
6130 sta pku+1 ! pick up char.
6140 lda mvt+1,x
6150 sta pku+2
6160 ldy #0
6170 pku lda $8000,y
6180 beq fme ! end
6190 cmp #$40
6200 bmi pk2
6210 sec
6220 sbc #$40
6230 pk2 sta $7c0,y
6240 lda #4
6250 sta $dbc0,y
6260 iny
6270 jmp pku
6280 fme rts
6290 mvt wor x1,x3,x5,x7,x2,x4,x6,x8
6300 x1 byt "return to 64-tel ",0
6310 x2 byt "change screen colour ",0
6320 x3 byt "toggle upper/lowercase ",0
6330 x4 byt "removing page from disk ",0
6340 x5 byt "toggle flash/reveal ",0
6350 x6 byt "saving page to disk ",0
6360 x7 byt "new page number ",0
6370 x8 byt "screen copied to ram ",0
6380 dvt wor f1,f3,f5,f7,f2,f4,f6,f8
6390 jmp ed1 ! checks later
6400 !
6410 ! move blocks of memory
6420 !
6430 move cmp #0
6440 bne mv1
6450 rts
6460 mv1 stx mv2+2
6470 sty mv2+5
6480 tax
6490 ldy #0
6500 mv2 lda $8000,y
6510 sta $8000,y
6520 iny
6530 bne mv2
6540 inc mv2+2
6550 inc mv2+5
6560 dex
6570 bne mv2
6580 rts
6590 !
6600 ! function key routines
6610 !
6620 f1 pla ! return to 64-tel
6630 pla
6640 rts
6650 f2 inc irc+1 ! colour change
6660 lda irc+1
6670 sta $7e8
6680 rts
6690 f3 lda $7ea ! change case
6700 eor #1
6710 sta $7ea
6720 tlc tax
6730 lda bc,x
6740 jmp $e716
6750 bc byt 14,142
6760 f5 lda $7e9 ! flash/reveal mode
6770 eor #1
6780 sta $7e9
6790 rts
6800 f7 lda #$60 ! new page no.
6810 sta $402
6820 sta $403
6830 lda #$31
6840 sta $401
6850 jsr gend
6860 sta ten
6870 clc
6880 adc #$30
6890 sta $402
6900 jsr gend
6910 sta un
6920 clc
6930 adc #$30
6940 sta $403
6950 jsr evn
6960 clc
6970 adc #100
6980 sta $7eb
6990 rts
7000 f8 lda #4 ! scrn --> copy
7010 ldx #4
7020 ldy #$08
7030 jmp move
7040 f6 jsr f4
7050 ldx #4
7060 f6e lda $7e8,x ! essentials
7070 sta $be8,x
7080 dex
7090 bpl f6e
7100 lda #4 ! save page to disk
7110 sta f6s+2
7120 lda #8
7130 sta f6c+2
7140 lda #$0c
7150 sta f6t+2
7160 lda #$d8
7170 sta f6r+2
7180 ldy #0
7190 f6s lda $8000,y ! get colour
7200 f6c cmp $8000,y ! any match
7210 php
7220 f6r lda $8000,y
7230 and #15
7240 plp
7250 beq f6t
7260 ora #$80
7270 f6t sta $8000,y
7280 iny
7290 bne f6s
7300 inc f6s+2
7310 inc f6c+2
7320 inc f6t+2
7330 inc f6r+2
7340 lda f6s+2
7350 cmp #8
7360 bne f6s
7370 tax
7380 lda #1
7390 ldy #255
7400 jsr $ffba
7410 ldx $beb
7420 stx dnam+2
7430 ldx #<dnam
7440 ldy #>dnam
7450 lda #3
7460 jsr $ffbd
7470 ldx #$f5
7480 ldy #$0f
7490 lda #0
7500 sta $fb
7510 lda #$08
7520 sta $fc
7530 lda #$fb
7540 jsr $ffd8 ! save $800 - $1000
7550 ldx $beb
7560 lda #$ff
7570 sta $1800,x ! this page filled
7580 lda $7eb ! new index page ?
7590 cmp #100
7600 bne nni ! no
7610 lda #8
7620 ldx #$8
7630 ldy #$10
7640 jsr move
7650 nni rts
7660 dnam byt "@:x"
7670 f4 ldx $7eb ! scratch a 64-tel
7680 ! page
7690 lda $1800,x ! does page exist?
7700 bne f41
7710 rts
7720 f41 lda #0
7730 sta $1800,x ! page now free
7740 stx com+3
7750 lda #4
7760 ldy #>com
7770 ldx #<com
7780 jsr $ffbd ! "@s0:x"
7790 lda #15
7800 ldx #8
7810 ldy #15
7820 jsr $ffba ! setlfs
7830 jsr $ffc0 ! send disk command
7840 lda #15
7850 jsr $ffc3 ! close file
7860 rts
7870 com byt "s0:a"
7880 d(NULL) jsr $ffbd ! disk load
7890 ldx #8
7900 lda #1
7910 ldy #255
7920 jsr $ffba
7930 lda #0
7940 jmp $ffd5
7950 ent ldx #8 ! end of 64-tel
7960 lda #1
7970 ldy #255
7980 jsr $ffba
7990 ldx #66
8000 stx dnam+2
8010 ldx #<dnam
8020 ldy #>dnam
8030 lda #3
8040 jsr $ffbd
8050 ldx #$f5
8060 ldy #$18
8070 lda #0
8080 sta $fb
8090 lda #$18
8100 sta $fc
8110 lda #$fb
8120 jsr $ffd8 ! save $1800 - $1900
8130 lda #0
8140 sta $7e9
8150 jmp $e544